home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS12.ADF
/
AmigaBBS
/
sysmail
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1986-08-05
|
8KB
|
195 lines
Main:
GOSUB Feedback
CHAIN "df0:Menus",10,ALL
Modem:
IF rings=0 THEN OtherModem
x=FRE(0)
FOR j= 1 TO LEN(a$):p$=MID$(a$,j,1)
PRINT p$;:PRINT#1,p$;:NEXT j
a$="":p$="":RETURN
OtherModem:
x=FRE(0)
FOR j= 1 TO LEN(a$):p$=MID$(a$,j,1)
PRINT p$;:NEXT j
a$="":p$="":RETURN
Answers:
telly=0:t$="":t=0:i$="":ch$="":alter=0:IF rings=0 THEN SomeAnswers
WHILE 1 AND alter<1
WHILE LOC(1)<>0
ch$=INPUT$(1,1)
equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
i$=i$+ch$:equivs=0
telly=telly+1:IF telly=78 THEN ch$=r$:telly=0
IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2):telly=telly-1
IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN alter=3:telly=0
a$=ch$:GOSUB Modem:ch$=""
WEND
ch$=INKEY$:i$=i$+ch$
a$=ch$:GOSUB Modem
IF ch$=CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN telly=0:GOTO MoreAnswers
IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
ch$="":IF LEN(i$)=0 THEN connect=PEEK (&Hbfd*&H1000+&H0):IF connect<>0 THEN okp=0:RETURN
WEND
IF i$<>"" THEN MoreAnswers
SomeAnswers:
ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
IF ch$= CHR$(10) OR ch$=CHR$(13) OR ch$=r$ THEN MoreAnswers
IF ch$=CHR$(8) AND LEN(i$)>=2 THEN i$=LEFT$(i$,LEN(i$)-2)
ch$=""
GOTO SomeAnswers
MoreAnswers:
IF okp<>1 THEN RETURN
IF i$="" THEN ch$="":GOTO Answers
t$=i$:IF LEN(t$)>80 THEN t$=LEFT$(t$,78)+r$
RETURN
SeqRead:
ERASE ABCS$:DIM ABCS$(185)
a$=r$+r$+"[> K Quits <]"+r$+r$:GOSUB Modem
OPEN "I", #3, file$
ReadSeq:
j=0:L=0:k=0:Countl=0
WHILE NOT EOF(3)
x=FRE(0):j=j+1
LINE INPUT#3,ABCS$(j):ABCS$(j)=ABCS$(j)+r$
WEND
CLOSE#3:k=j:L=0:Detect=0
WHILE L<k
L=L+1:a$=ABCS$(L):GOSUB Modem
CheckSeq:
t$="":t=0:i$="":ch$="":IF rings=0 THEN SomeCheckSeq
WHILE LOC(1)<>0
ch$=INPUT$(1,1):equivs=ASC(ch$) AND 127:IF equivs<>1 THEN ch$=CHR$(equivs)
i$=i$+ch$:equivs=0:a$=ch$:GOSUB Modem
WEND
IF i$<>"" THEN MoreCheckSeq
SomeCheckSeq:
ch$=INKEY$:i$=i$+ch$:a$=ch$:GOSUB Modem
OtherCheckSeq:
IF Detect=1 GOTO MoreCheckSeq
Countl=Countl+1:IF Countl=24 THEN a$=r$+"More (y,n,c)?":GOSUB A1
IF Countl=24 THEN MenS$=UCASE$(LEFT$(t$,1)):IF MenS$="N" THEN L=k+1
IF Countl=24 AND MenS$="Y" THEN Countl=0
IF Countl=24 AND MenS$="C" THEN Detect=1
IF Countl=24 AND Detect<>1 THEN Countl=0
MoreCheckSeq:
IF i$=CHR$(75) OR i$=CHR$(107) THEN L=k+1
WEND
ERASE ABCS$:DIM ABCS$(185):RETURN
A1:
GOSUB Modem:GOSUB Answers:RETURN
CheckConTime:
Contime$=TIME$:ChEntTime$=RIGHT$(EntTime$,5):Contime$=RIGHT$(Contime$,5)
Contime=VAL(Contime$):EntTime=VAL(ChEntTime$)
IF Contime-EntTime>30 AND Veru$="000" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
IF Contime-EntTime>45 AND Veru$="007" THEN okp=0:a$=r$+"Time limit exceeded."+r$:GOSUB Modem:RETURN
okp=1:RETURN
Feedback:
a$=r$+"Enter Message: [Max. 40 lines] /EX to Exit"+r$:GOSUB Modem
Extm=0:Ddt=3
WHILE Extm<1
Ddt=Ddt+1
a$=r$+STR$(Ddt-3)+":":GOSUB A1
ABCS$(Ddt)=t$
IF UCASE$(LEFT$(t$,3))="/EX" THEN Extm=1:Ddt=Ddt-1
IF Ddt=42 THEN a$=r$+"Last Line!":GOSUB Modem
IF Ddt=43 THEN Extm=1
WEND
ABCS$(1)="Time:"+TIME$+" "+"Date:"+DATE$+r$
ABCS$(2)="Name:"+Name1$+" "+Name2$+"UserID:"+UserID$+r$
ABCS$(3)=r$
QueryFeedback:
a$=r$+" S- Save L- List A- Abort C- Continue E- Edit:":GOSUB A1
MenS$=UCASE$(LEFT$(t$,1))
IF MenS$="S" THEN SaveFeedback
IF MenS$="L" THEN ListFeedback
IF MenS$="A" THEN RETURN
IF MenS$="C" THEN ContFeedback
IF MenS$="E" THEN EditFeedback
GOTO QueryFeedback
SaveFeedback:
OPEN "A", #3, "df1:Feedback"
FOR j=1 TO Ddt
PRINT#3,ABCS$(j)
NEXT j
CLOSE#3:a$=r$+"Thank you for your Feedback."+r$:GOSUB Modem
RETURN
InsertEditFeedback:
IF Ddt>=199 THEN a$=r$+"No room to insert.":GOSUB Modem:GOTO EditFeedback
a$=r$+"Insert before which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN EditFeedback
instln=VAL(t$)+3
FOR j=Ddt TO instln STEP -1
ABCS$(j+1)=ABCS$(j)
NEXT j
ABCS$(instln)=" "+r$:Ddt=Ddt+1
GOTO EditFeedback
EditFeedback:
a$=r$+"R- Replace I- Insert D- Delete S- Save X- Exit:":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
IF MenS$="R" THEN ReplaceEditFeedback
IF MenS$="I" THEN InsertEditFeedback
IF MenS$="D" THEN DeleteEditFeedback
IF MenS$="S" THEN SaveFeedback
IF MenS$="X" THEN QueryFeedback
GOTO EditFeedback
DeleteEditFeedback:
a$=r$+"Delete starting which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN EditFeedback
stln=VAL(t$)+3:IF stln<4 OR stln>Ddt THEN EditFeedback
a$=r$+"Ending which line:":GOSUB A1:endtln=VAL(t$)+3:IF endtln>Ddt THEN endtln=Ddt
IF stln>endtln THEN SWAP stln,endtln
a$=r$+"Delete from"+STR$(stln-3)+" to"+STR$(endtln-3)+r$+"Are you sure? (Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
IF MenS$="N" THEN EditFeedback
FOR j=endtln+1 TO Ddt
ABCS$(j-((endtln+1)-stln))=ABCS$(j)
NEXT j
Ddt=Ddt-((endtln+1)-stln)
FOR j=Ddt TO Ddt+((endtln+1)-stln)
ABCS$(j)=" "+r$
NEXT j
GOTO EditFeedback
ListFeedback:
a$=r$+"Line to start at:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN QueryFeedback
stln=VAL(t$)+3:IF stln<4 OR stln>Ddt THEN QueryFeedback
a$=r$+"Line to stop at:":GOSUB A1:endtln=VAL(t$)+3:IF endtln<stln THEN QueryFeedback
IF endtln>Ddt THEN endtln=Ddt
a$=r$:GOSUB Modem
FOR L=stln TO endtln
a$=STR$(L-3)+":"+ABCS$(L):GOSUB Modem:NEXT L:GOTO QueryFeedback
ReplaceEditFeedback:
a$=r$+"Replace which line:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN EditFeedback
rplnn=VAL(t$)+3:IF rplnn<4 OR rplnn>Ddt THEN EditFeedback
a$=r$+"Replace:"+ABCS$(rplnn)+"With:":GOSUB A1:IF t$=CHR$(10) OR t$=CHR$(13) THEN EditFeedback
Temprep$=t$
a$=r$+"Replace:"+ABCS$(rplnn)+"With:"+Temprep$+"(Y or N):":GOSUB A1:MenS$=UCASE$(LEFT$(t$,1))
IF MenS$="Y" THEN ABCS$(rplnn)=Temprep$
GOTO EditFeedback
ContinueFeedback:
IF Ddt>198 THEN a$=r$+"No Room!":GOTO QueryFeedback
Dzz=0
a$=r$+"Enter Text: [Max. 197 lines] /EX to Exit":GOSUB Modem
WHILE Dzz<1
Ddt=Ddt+1
a$=r$+STR$(Ddt-3)+":":GOSUB A1:ABCS$(Ddt)=t$
IF UCASE$(LEFT$(t$,3))="/EX" THEN Dzz=1:Ddt=Ddt-1
IF Ddt=199 THEN a$=r$+"Last Line!":GOSUB Modem
IF Ddt=200 THEN Dzz=1
WEND
GOTO QueryFeedback
Teflon:
IF teetse=1 THEN a$=r$+"Sorry, not allowed!":GOSUB Modem:okp=1:GOTO Menus
IF teetse=0 THEN ltomr=1:teetse=1:RETURN
RETURN